home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 05 - 1989 / 05.06 Jun 89 / Basic Source / Call Help.BAS next >
Encoding:
BASIC Source File  |  1989-04-15  |  3.8 KB  |  191 lines  |  [TEXT/ZBAS]
  1. 'This program demonstrates the use of the
  2. 'ZBasic 5.0 CALL statement when calling
  3. 'a (LS) PASCAL CODE resource.
  4.  
  5. '©1989 MacTutor
  6. 'By Dave Kelly
  7.  
  8. WINDOW OFF
  9. COORDINATE WINDOW
  10. DEF MOUSE=-1
  11. MOUSE ON
  12. BREAK ON
  13. DEFSTR LONG:T&=CVI("CODE")
  14. DEF LEN=255
  15. DIM B%(7)
  16. GOSUB "Define Help Cursor"
  17. APPLE MENU "About Call Help"
  18. MENU 1,0,1,"File"
  19. MENU 1,1,1,"Open…"
  20. MENU 1,2,1,"Close"
  21. MENU 1,3,0,"-"
  22. MENU 1,4,1,"Save"
  23. MENU 1,5,1,"Save As…"
  24. MENU 1,6,0,"-"
  25. MENU 1,7,1,"Page Setup…"
  26. MENU 1,8,1,"Print…"
  27. MENU 1,9,0,"-"
  28. MENU 1,10,1,"Quit"
  29. EDIT MENU 2
  30. Message%=0 'Set up string parameters
  31. HelpCursor%=0
  32.  
  33. 'Find out screen size.
  34. CALL GETWMGRPORT(WMgrPort&)
  35. PortTop=PEEK WORD(WMgrPort&+8)
  36. PortLeft=PEEK WORD(WMgrPort&+10)
  37. PortBottom=PEEK WORD(WMgrPort&+12)
  38. PortRight=PEEK WORD(WMgrPort&+14)
  39.  
  40. WINDOW 1,"Main Window",(10,44)-(PortRight-4,PortBottom-4),5
  41. GET WINDOW #1, WindowPtr&
  42.  
  43. ON MENU GOSUB "Do MenuEvent"
  44. ON DIALOG GOSUB "Do DialogEvent"
  45. MENU ON:DIALOG ON:BREAK ON
  46. "Loop"
  47. CALL GETKEYS(B%(0))
  48. LONG IF B%(2)=16 AND B%(3)=-32767
  49.         GOSUB "ChangeCursor"
  50. END IF
  51. GOTO "Loop"
  52.  
  53. DIALOG OFF:MENU OFF
  54. "Do MenuEvent"
  55. Menunumber=MENU(0)
  56. Menuitem=MENU(1)
  57. MENU
  58. SELECT Menunumber
  59. CASE 255
  60.         Message%=0
  61.         GOSUB "Do Call"
  62. CASE 1
  63.         GOSUB "Do File Menu"
  64. END SELECT
  65. HelpCursor%=1
  66. Message%=0
  67. GOSUB "ChangeCursor"
  68. RETURN
  69.  
  70. "Do File Menu"
  71. LONG IF HelpCursor%=0
  72.         SELECT Menuitem
  73.                 CASE 1  'Open
  74.                 CASE 2  'Close
  75.                 CASE 4  'Save
  76.                 CASE 5  'Save As…
  77.                 CASE 7  'Page Setup…
  78.                         DEF PAGE
  79.                 CASE 8  'Print…
  80.                         DEF LPRINT
  81.                 CASE 10 'Quit
  82.                         GOTO "Quit"
  83.         END SELECT
  84. XELSE
  85.         SELECT Menuitem
  86.                 CASE 1  'Open
  87.                         Message%=1
  88.                         GOSUB "Do Call"
  89.                 CASE 2  'Close
  90.                         Message%=2
  91.                         GOSUB "Do Call"
  92.                 CASE 4  'Save
  93.                         Message%=4
  94.                         GOSUB "Do Call"
  95.                 CASE 5  'Save As…
  96.                         Message%=5
  97.                         GOSUB "Do Call"
  98.                 CASE 7  'Page Setup…
  99.                         Message%=7
  100.                         GOSUB "Do Call"
  101.                 CASE 8  'Print…
  102.                         Message%=8
  103.                         GOSUB "Do Call"
  104.                 CASE 10 'Quit
  105.                         Message%=10
  106.                         GOSUB "Do Call"
  107.         END SELECT
  108. END IF
  109. RETURN
  110.  
  111. "Quit"
  112. END
  113.  
  114. "Do DialogEvent"
  115. D=DIALOG(0):DI=DIALOG(D)
  116. SELECT D
  117.         CASE 1  'Button
  118.         CASE 2  'Edit Field
  119.         CASE 3  'Inactive Window
  120.         CASE 4  'Close Box
  121.                 GOTO "Quit"
  122.         CASE 5  'Window Update
  123.         CASE 6  'Return Key
  124.         CASE 7  'Tab Key
  125.         CASE 8  'Zoom-in
  126.         CASE 9  'Zoom-out
  127.         CASE 10 'Shift-Tab
  128.         CASE 11 'Clear Key
  129.         CASE 12 'Left-Arrow
  130.         CASE 13 'Right-Arrow
  131.         CASE 14 'Up-Arrow
  132.         CASE 15 'Down-Arrow
  133.         CASE 16 'Event inkey$
  134.                 IF DI=5 THEN GOSUB "Do Call"
  135.         CASE 17 'Disk Insert
  136. END SELECT 
  137. RETURN
  138.  
  139. "Do Call"
  140. LONG IF Message%=0
  141.         Id=500  'Help DA
  142. XELSE
  143.         Id=501  'Context Sensitive Help
  144. END IF
  145. Result&=0:Y%=0
  146. SCode&= FN GETRESOURCE(T&,Id) 'load the call into memory
  147. IF SCode&=0 THEN PRINT "Opps":END    'End if there is no call to call
  148. Y%=FN HLOCK(SCode&)  ' Lock a Relocatable Memory Block
  149. ActualCode&=PEEK LONG (SCode&)
  150. LONG IF Message%=0
  151.         CALL ActualCode&    'Call the Help procedure
  152. XELSE
  153.         CALL ActualCode&(Message%)    'Call the Context Sensitive Help function
  154. END IF
  155. CALL RELEASERESOURCE(SCode&)
  156. Y%=FN HUNLOCK(SCode&)  'Unlock a "Locked" Handle
  157. Y%=FN DISPOSHANDLE(SCode&)  'Dispose of Memory block pointed to by a Handle
  158. Message%=0 'Set up string parameters
  159. RETURN
  160.  
  161. "Define Help Cursor"
  162. DIM A%(40)
  163. A%(0)=&H0000:A%(1)=&H3F80:A%(2)=&H7FC0:A%(3)=&H60C0
  164. A%(4)=&H60C0:A%(5)=&H00C0:A%(6)=&H01C0:A%(7)=&H0380
  165. A%(8)=&H0700:A%(9)=&H0E00:A%(10)=&H0C00:A%(11)=&H0C00
  166. A%(12)=&H0000:A%(13)=&H0C00:A%(14)=&H0C00:A%(15)=&H0000
  167. A%(16)=&H3F80:A%(17)=&H7FC0:A%(18)=&HFFE0:A%(19)=&HFFE0
  168. A%(20)=&HF1E0:A%(21)=&HF1E0:A%(22)=&H03E0:A%(23)=&H07C0
  169. A%(24)=&H0F80:A%(25)=&H1F00:A%(26)=&H1E00:A%(27)=&H1E00
  170. A%(28)=&H1E00:A%(29)=&H1E00:A%(30)=&H1E00:A%(31)=&H1E00
  171. A%(32)=&H0004:A%(33)=&H0002
  172. HelpCursor%=0
  173. RETURN
  174.  
  175. "ChangeCursor"
  176. LONG IF HelpCursor%=0
  177.         CALL SETCURSOR(A%(0))
  178.         CALL SHOWCURSOR
  179.         HelpCursor%=1
  180. XELSE
  181.         CURSOR=0
  182.         HelpCursor%=0
  183. END IF
  184. WHILE B%(2)=16 AND B%(3)=-32767
  185.         CALL GETKEYS(B%(0))
  186. WEND
  187. RETURN
  188.  
  189.  
  190.  
  191.